(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
T)
(LISPXPRIN1 (QUOTE " 8-JUN-73 1:05:10")
T)
(LISPXTERPRI T))
(LISPXPRINT (QUOTE PUPVARS)
T)
[RPAQQ PUPVARS
(NEED REQUIRE W $PGM $UNUSEDVARS
(FNS RAMIFICATIONS REV2ELS CELLEQUAL LISTEQUAL
REPLACECDR REPLACECAR MAKENULL RPLAC NEWCELL
STORECVALUE CONSC SETQC TRANSITIVECLOSURE
TRYANYTHINGANTISYMPARTIAL SIMPLEGOAL SOLVE SETUP
INIT GETNEWLOCNAME DENYALL SERIESGOAL ORGOAL
ANDGOAL XORGOAL BUILDPGM)
(P (QSETUP PUPVARS]
(RPAQQ NEED NIL)
(RPAQQ REQUIRE NIL)
(RPAQQ W
(FNS RAMIFICATIONS REV2ELS CELLEQUAL LISTEQUAL REPLACECDR
REPLACECAR MAKENULL RPLAC NEWCELL STORECVALUE CONSC SETQC
TRANSITIVECLOSURE TRYANYTHINGANTISYMPARTIAL SIMPLEGOAL
SOLVE SETUP INIT GETNEWLOCNAME DENYALL SERIESGOAL ORGOAL
ANDGOAL XORGOAL BUILDPGM))
(RPAQQ $PGM (TUPLE))
(RPAQQ $UNUSEDVARS
(CLASS U5 U4 U3 U2 U6 U7 U8 U9 U10 U11 U12 U13 U14 U15 U16 U17
U1))
(DEFINEQ
(RAMIFICATIONS
[QLAMBDA
(TUPLE ←A
←B)
(QPROG (←L
←NEXT
←S1
←S2
←S3)
(QMATCHQ ←L
(QINSTANCES ←←ANY))
B1
(QATTEMPT (QMATCHQ (CLASS ←NEXT
←←L)
$L)
ELSE (QRETURN TRUE))
B2
[QATTEMPT (QMATCHQ (TUPLE ←←S1
$A ←←S2
$B ←←S3)
$NEXT)
THEN (QPROG NIL (QDELETE (TUPLE $$S1 $A $$S2 $B $$S3))
(QASSERT (TUPLE $$S1 $B $$S2 $A $$S3))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$B ←←S2
$A ←←S3)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $B $$S2 $A $$S3))
(QASSERT (TUPLE $$S1 $A $$S2 $B $$S3))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$A ←←S2)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $A $$S2))
(QASSERT (TUPLE $$S1 $B $$S2))
(GOTO B3))
ELSE (QATTEMPT (QMATCHQ (TUPLE ←←S1
$B ←←S2)
$NEXT)
THEN (QPROG NIL
(QDELETE (TUPLE $$S1 $B
$$S2))
(QASSERT (TUPLE $$S1 $A
$$S2]
B3
(QATTEMPT (QMATCHQ (TUPLE ←←S1
(TUPLE ←←NEXT)←←S2)
$NEXT)
THEN (GOTO B2)
ELSE (GOTO B1])
(REV2ELS
(QLAMBDA (TUPLE ←RELN
←A
←B)
(QIF (QAND (QEQUAL (QGET $RELN PARTIAL)
TRUE)
(QEQUAL (QGET $RELN ANTISYM)
TRUE))
ELSE (QFAIL))
(QATTEMPT (QEXISTS (TUPLE $RELN $B $A))
ELSE (TRANSITIVECLOSURE (TUPLE $RELN $B $A)))
(QEXISTS (TUPLE C $A ←ACON))
(QEXISTS (TUPLE C $B ←BCON))
(QGOAL (TUPLE SERIES (TUPLE C $A $BCON)
(TUPLE C $B $ACON))
APPLY $GOALTYPE)))
(CELLEQUAL
(QLAMBDA (CLASS ←A
←B)
(QAND (QATTEMPT (QEXISTS (TUPLE C $A ←VAL1)))
(QATTEMPT (QEXISTS (TUPLE C $B ←VAL2)))
(QEQUAL $VAL1 $VAL2))))
(LISTEQUAL
[QLAMBDA (CLASS ←A
←B)
(QPROG (←E1
←E2
←E3
←E4)
(QATTEMPT (QMATCHQ (TUPLE ←E1
←←E2)
$A)
THEN (QMATCHQ (TUPLE ←E3
←←E4)
$B)
ELSE (QATTEMPT (QMATCHQ (TUPLE ←E3
←←E4)
$B)
THEN (QRETURN FALSE)
ELSE (QRETURN TRUE)))
(QIF (QAND (CELLEQUAL (CLASS $E1 $E3))
(LISTEQUAL (CLASS $E2 $E4)))
THEN (QRETURN TRUE)
ELSE (QRETURN FALSE])
(REPLACECDR
(QLAMBDA (TUPLE LIST ←L
←NEWCDR
←OLDCDR
←CAR)
(QDELETE (TUPLE LIST $L (TUPLE $CAR $$OLDCDR)))
(QASSERT (TUPLE LIST $L (TUPLE $CAR $$NEWCDR)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE REPLACE CDR OF LIST $L
WHICH WAS $OLDCDR BY $NEWCDR)
(TUPLE RPLACD $NEWCDR $L)
$$PGM))))
(REPLACECAR
(QLAMBDA (TUPLE LIST ←L
←NEWCAR
←OLDCAR
←CDR)
(QMATCHQ ←NEWLIST
(TUPLE $NEWCAR $$CDR))
(QMATCHQ ←OLDLIST
(TUPLE $OLDCAR $$CDR))
(QDELETE (TUPLE LIST $L $OLDLIST))
(QASSERT (TUPLE LIST $L $NEWLIST))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE REPLACE CAR OF LIST $L
WHICH WAS $OLDCAR
BY THE CELL $NEWCAR)
(TUPLE RPLACA $NEWCAR $L)
$$PGM))))
(MAKENULL
(QLAMBDA (TUPLE LIST ←L
(TUPLE))
(QATTEMPT (QEXISTS (TUPLE LIST $L ←ANY))
THEN (QDELETE (TUPLE LIST $L $ANY)))
(QASSERT (TUPLE LIST $L (TUPLE)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE SET LIST $L TO NULL)
(TUPLE SETQ $L NIL)
$$PGM))))
(RPLAC
[QLAMBDA (TUPLE LIST ←L
(TUPLE ←CAR
←←CDR))
(QEXISTS (TUPLE LIST $L (TUPLE ←←CURRENT)))
(QMATCHQ (TUPLE ←CURCAR
←←CURCDR)
$CURRENT)
(QIF (LISTEQUAL (CLASS $CURCDR $CDR))
THEN (REPLACECAR (TUPLE LIST $L $CAR $CURCAR $CDR))
ELSE (QIF (CELLEQUAL (CLASS $CURCAR $CAR))
THEN (REPLACECDR (TUPLE LIST $L $CDR $CURCDR $CAR)
)
ELSE (QFAIL])
(NEWCELL
[QLAMBDA (TUPLE ←VAL
←LOC)
(QPROG (←AUXLOC)
(QMATCHQ (CLASS ←AUXLOC
←←UNUSEDVARS)
$UNUSEDVARS)
(QASSERT (TUPLE C $AUXLOC $VAL))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT I MAY NEED $VAL LATER
SO BEFORE I STORE SOMETHING
IN LOCATION $LOC I AM TRANSFERRING
$VAL
TO THE NEWLY CREATED LOCATION
$AUXLOC)
(TUPLE SETQ $AUXLOC $LOC)
$$PGM])
(STORECVALUE
[QLAMBDA ←LOC
(QPROG (←VALU
←RESERVE)
(QATTEMPT (QEXISTS (TUPLE C $LOC ←VALU))
THEN (QATTEMPT (QBEXISTS
(TUPLE C ←RESERVE
$VALU)
THEN (QIF (QEQUAL $RESERVE
$LOC)
THEN (QFAIL)
ELSE (QPUT
(TUPLE C
$RESERVE
$VALU)
NEEDED TRUE)))
ELSE (NEWCELL (TUPLE $VALU $LOC)))
ELSE (QRETURN TRUE])
(CONSC
[QLAMBDA
(TUPLE LIST ←L
(TUPLE ←CAR
←←CDR))
(QPROG (←M
←S1
←S2)
(QATTEMPT (QGOAL (TUPLE LIST $L $CDR)
APPLY $GOALTYPE)
THEN (QATTEMPT (QEXISTS (TUPLE LIST ←M
(TUPLE ←←S1
$CAR ←←S2)))
THEN [QPROG (←M2
←T)
(QMATCHQ ←T
(GETNEWLOCNAME))
(QDELETE (TUPLE LIST $L $CDR))
(QMATCHQ ←M2
(TUPLE $T $$CDR))
(QASSERT (TUPLE LIST $L $M2))
(QMATCHQ
←PGM
(TUPLE (TUPLE COMMENT WE JUST
TOOK THE NEW CELL
$T
AND CONSED IT ONTO $L
SINCE $CAR ALREADY
BELONGS
TO ANOTHER LIST
STRUCTURE NAMELY $M)
(TUPLE SETQ $T $CAR)
(TUPLE SETQ L
(TUPLE CONS $T $L))
$$PGM))
(QATTEMPT (QEXISTS (TUPLE C $CAR
←M2))
THEN (QASSERT (TUPLE C $T $M2]
ELSE (QPROG (←TEMP)
(QDELETE (TUPLE LIST $L $CDR))
(QMATCHQ ←TEMP
(TUPLE $CAR $$CDR))
(QASSERT (TUPLE LIST $L $TEMP))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT WE
JUST TOOK $CAR
AND CONSED IT ONTO
LIST $L)
(TUPLE SETQ $L
(TUPLE CONS
$CAR $L))
$$PGM])
(SETQC
[QLAMBDA (TUPLE C ←NEWLOC
←NEWVAL)
(QPROG (←OLDLOC
←LOC2
←V)
(QATTEMPT (QEXISTS (TUPLE C $NEWLOC ←V)
REQUIRED TRUE)
THEN (QFAIL QPROG))
(QEXISTS (TUPLE C ←OLDLOC
$NEWVAL))
(QATTEMPT (QEXISTS (TUPLE C ←LOC2
$NEWVAL)
NEEDED TRUE)
ELSE (QPUT (TUPLE C $OLDLOC $NEWVAL)
NEEDED TRUE))
(QEXISTS (TUPLE C ←OLDLOC
$NEWVAL)
NEEDED TRUE)
(STORECVALUE $NEWLOC)
(BUILDPGM (TUPLE $NEWLOC $NEWVAL $OLDLOC))
(QDELETE (TUPLE C $NEWLOC ←V))
(QASSERT (TUPLE C $NEWLOC $NEWVAL])
(TRANSITIVECLOSURE
[QLAMBDA (TUPLE ←RELN
←A
←B)
(QIF (QEQUAL (QGET (TUPLE $RELN TRANSITIVE))
TRUE)
ELSE (QFAIL))
(QBEXISTS (TUPLE $RELN $A ←ANY)
THEN (QIF (QEQUAL $ANY $B)
THEN (QASSERT (TUPLE $RELN $A $B))
ELSE (TRANSITIVECLOSURE (TUPLE $RELN $ANY $B])
(TRYANYTHINGANTISYMPARTIAL
(QLAMBDA (TUPLE ←TYPE
←←STUFF
(TUPLE ←RELN
←A
←B)←←STUFF2)
(QIF (QAND (QGET $RELN ANTISYM)
(QGET $RELN PARTIAL))
ELSE (QFAIL))
(QIF (QOR (QATTEMPT (QEXISTS (TUPLE $RELN $A $B))
THEN (QNOTEQUAL (QGET (TUPLE $RELN $A $B)
TEMP)
TRUE))
(QATTEMPT (QEXISTS (TUPLE $RELN $B $A))
THEN (QNOTEQUAL (QGET (TUPLE $RELN $B $A)
TEMP)
TRUE)))
THEN (QFAIL))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT IF $A $RELN $B
THEN)
(TUPLE COND (TUPLE $RELN $A $B))
$$PGM))
(QASSERT (TUPLE $RELN $A $B))
(QPUT (TUPLE $RELN $A $B)
TEMP TRUE)
(QATTEMPT (QGOAL (TUPLE $TYPE $$STUFF (TUPLE $RELN $A $B)
$$STUFF2)
APPLY $GOALTYPE)
ELSE (QMATCHQ ←PGM
(TUPLE (TUPLE PRINT GIVEUP)
$$PGM)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT END OF THE
THEN PART OF THE COND
AND THUS BEGIN THE
ELSE PART OF THE COND)
(TUPLE (TUPLE T))
$$PGM))
(QDELETE (TUPLE $RELN $A $B))
(QASSERT (TUPLE $RELN $B $A))
(QPUT (TUPLE $RELN $B $A)
TEMP TRUE)
(QATTEMPT (QGOAL (TUPLE $TYPE $$STUFF (TUPLE $RELN $A $B)
$$STUFF2)
APPLY $GOALTYPE)
ELSE (QMATCHQ ←PGM
(TUPLE (TUPLE PRINT GIVEUP)
$$PGM)))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT END OF COND EXPRESSION)
$$PGM))
(QDELETE (TUPLE $RELN $B $A))
BACKTRACK))
(SIMPLEGOAL
[QLAMBDA ←ANYTHING
(QGOAL $ANYTHING APPLY $DO)
(COND
(REQUIRE (QPUT $ANYTHING REQUIRED TRUE])
(SOLVE
[QLAMBDA ←PROBLEM
(QGOAL $PROBLEM APPLY $GOALTYPE)
(QMATCHQ ←PGM
(QREVERSE $PGM))
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT BEGINNING OF PROGRAM)
$$PGM
(TUPLE COMMENT END OF PROGRAM])
(SETUP
(QLAMBDA ←ANYTHING
(DENYALL)
(QASSERT (TUPLE C A A3))
(QASSERT (TUPLE C B B3))
(QASSERT (TUPLE C C C3))
(QASSERT (TUPLE C D D3))
(QASSERT (TUPLE C E E3))
(QASSERT (TUPLE C F F3))
(QASSERT (TUPLE C G G3))
(QASSERT (TUPLE C I I3))
(QASSERT (TUPLE C J J3))
(QASSERT (TUPLE C K K3))
(QASSERT (TUPLE C H H3))
(QASSERT (TUPLE LIST L1 (TUPLE)))
(QASSERT (TUPLE LIST L2 (TUPLE)))
(QASSERT (TUPLE LIST L3 (TUPLE)))
(QASSERT (TUPLE LIST L4 (TUPLE A B C)))
(QASSERT (TUPLE LIST L5 (TUPLE D E)))
(QASSERT (TUPLE LESS I J))
(QASSERT (TUPLE LESS J K))
(QASSERT (TUPLE LESS H I))
(QPUT LESS ANTISYM TRUE)
(QPUT LESS PARTIAL TRUE)
(QPUT LESS TRANSITIVE TRUE)
(TUPLE SETUP COMPLETED)))
(INIT
(QLAMBDA ←ANYTHING
(QMATCHQ ←GOALTYPE
(TUPLE ORGOAL ANDGOAL XORGOAL SERIESGOAL SIMPLEGOAL
TRYANYTHINGANTISYMPARTIAL))
(QMATCHQ ←DO
(TUPLE SETQC RPLAC CONSC MAKENULL TRANSITIVECLOSURE
REV2ELS))
(QMATCHQ ←PGM
(TUPLE))
(QMATCHQ ←UNUSEDVARS
(CLASS U1 U2 U3 U4 U5 U6 U7 U8 U9 U10 U11 U12 U13
U14 U15 U16 U17))
(QMATCHQ ←UNUSEDV
$UNUSEDVARS)
$ANYTHING))
(GETNEWLOCNAME
(QLAMBDA ←ANYTHING
(QPROG (←X)
(QMATCHQ (CLASS ←X
←←UNUSEDVARS)
$UNUSEDVARS)
(QRETURN $X))))
(DENYALL
[QLAMBDA ←ANYTHING
(QATTEMPT (QDELETE (TUPLE C ←C1
←V1)))
[QATTEMPT (QDELETE (TUPLE LIST ←L1
(TUPLE ←←V1]
(QATTEMPT (QDELETE (TUPLE LESS ←C1
←V1])
(SERIESGOAL
(QLAMBDA (TUPLE SERIES ←Z1
←←Z2)
(SETQ NEED NIL)
(SETQ REQUIRE NIL)
(QGOAL $Z1 APPLY $GOALTYPE)
(QIF (QEQUAL $Z2 (TUPLE))
THEN $PGM
ELSE (QGOAL (TUPLE SERIES $$Z2)
APPLY $GOALTYPE))))
(ORGOAL
(QLAMBDA (CLASS OR ←Z1
←←Z2)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT
FROM THE ORTASK WE SHALL
DO $Z1)
$$PGM))
ELSE (QGOAL (CLASS OR $$Z2)
APPLY $GOALTYPE))))
(ANDGOAL
[QLAMBDA (CLASS AND ←←Z)
(QPROG (←Z1
←Z2
←Z3)
(QMATCHQ ←Z3
(CLASS))
B1
(QMATCHQ (CLASS ←Z1
←←Z2)
$Z)
(QMATCHQ ←Z3
(CLASS $$Z3 $Z1))
(QMATCHQ ←Z
(CLASS $$Z2))
(SETQ NEED T)
(SETQ REQUIRE T)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QIF (QEQUAL $Z2 (CLASS))
THEN (QIF (QEQUAL $Z3 (CLASS))
THEN $PGM
ELSE (QGOAL (CLASS AND $$Z3)
APPLY $GOALTYPE))
ELSE (QGOAL (CLASS AND $$Z2)
APPLY $GOALTYPE))
ELSE (GO B1])
(XORGOAL
(QLAMBDA (CLASS XOR ←Z1
←←Z2)
(QATTEMPT (QGOAL $Z1 APPLY $GOALTYPE)
THEN (QATTEMPT (QGOAL (CLASS NONEOF $$Z2)
APPLY $GOALTYPE)
THEN (QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT OF THE
EXCLUSIVE
OR GOAL WE DID $Z1
AND NO OTHERS ARE
SATISFIED)
$$PGM)))
ELSE (QGOAL (CLASS XOR $$Z2)
APPLY $GOALTYPE))))
(BUILDPGM
(QLAMBDA (TUPLE ←NEWLOC
←NEWVAL
←OLDLOC)
(QMATCHQ ←PGM
(TUPLE (TUPLE COMMENT I JUST TRANSFERRED THE VALUE
$NEWVAL FROM CELL $OLDLOC
TO CELL $NEWLOC)
(TUPLE SETQ $NEWLOC $OLDLOC)
$$PGM))))
)
(QSETUP PUPVARS)
STOP